home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / Screen Loc197025172001.psc / ClsTranslution.cls < prev    next >
Encoding:
Visual Basic class definition  |  2001-02-25  |  2.6 KB  |  87 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "ClsTranslution"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15.  
  16. 'Translucent Forms...
  17. Private Declare Function ReleaseDC Lib "USER32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
  18. Private Declare Function GetDC Lib "USER32" (ByVal hWnd As Long) As Long
  19. Private Declare Function GetDesktopWindow Lib "USER32" () As Long
  20. Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
  21. Private Const SRCCOPY = &HCC0020
  22.  
  23. 'For Dragging Borderless Forms...
  24. Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  25. Private Declare Function ReleaseCapture Lib "USER32" () As Long
  26. Private Const WM_NCLBUTTONDOWN = &HA1
  27. Private Const HTCAPTION = 2
  28.  
  29. 'Prevents function recursion...
  30. Public iRecursion As Boolean
  31. Public tColor As Long
  32. Public Sub DragForm(Who As Form)
  33.  
  34. On Local Error Resume Next
  35.  
  36. 'Move the borderless form...
  37. Call ReleaseCapture
  38. Call SendMessage(Who.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
  39.  
  40. End Sub
  41. Public Sub MakeTranslucent(Who As Variant, Optional tColor As Long)  'Was (Who as Object) before...
  42.  
  43. On Local Error Resume Next
  44.  
  45. Dim HW As Long
  46. Dim HA As Long
  47. Dim iLeft As Integer
  48. Dim iTop As Integer
  49. Dim iWidth As Integer
  50. Dim iHeight As Integer
  51.  
  52. If IsMissing(tColor) Or tColor = 0 Then
  53.     tColor = RGB(0, 0, 200)
  54. End If
  55.  
  56. Who.AutoRedraw = True
  57. Who.Hide
  58.  
  59. DoEvents
  60.  
  61. HW = GetDesktopWindow()
  62. HA = GetDC(HW)
  63.  
  64. 'Get the Left, Top, Width and Height of the Form...
  65. iLeft = Who.Left / Screen.TwipsPerPixelX
  66. iTop = Who.Top / Screen.TwipsPerPixelY '+ 25    If using a form with a titlebar (border)...
  67. iWidth = Who.ScaleWidth
  68. iHeight = Who.ScaleHeight
  69.  
  70. 'Now, Transfer the contents of the Desktop Window to the Form...
  71. Call BitBlt(Who.hdc, 0, 0, iWidth, iHeight, HA, iLeft, iTop, SRCCOPY) 'iLeft + 4    If using a form with a titlebar (border)...
  72.  
  73. 'Show...
  74. Who.Picture = Who.Image
  75. 'Who.Show
  76.  
  77. 'Release the DC...
  78. Call ReleaseDC(HW, HA)
  79.  
  80. 'Add color...
  81. Who.DrawMode = 9
  82. Who.ForeColor = tColor
  83. Who.Line (0, 0)-(iWidth, iHeight), , BF
  84.  
  85. End Sub
  86.  
  87.